home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / sbin / install-sgmlcatalog < prev    next >
Text File  |  2004-10-26  |  5KB  |  158 lines
  1. #!/usr/bin/perl
  2. ## ----------------------------------------------------------------------
  3. ## install-sgmlcatalog : Debian SGML catalog management tool
  4. ## ----------------------------------------------------------------------
  5. ## Copyright (c) 1997 Christian Schwarz
  6. ## Copyright (c) 2001-2004 Ardo van Rangelrooij
  7. ##
  8. ## This is free software; see the GNU General Public Licence version 2
  9. ## or later for copying conditions.  There is NO warranty.
  10. ## ----------------------------------------------------------------------
  11.  
  12. ## ----------------------------------------------------------------------
  13. use strict;
  14. use warnings;
  15.  
  16. ## ----------------------------------------------------------------------
  17. use Getopt::Long qw( &GetOptions );
  18.  
  19. ## ----------------------------------------------------------------------
  20. $0 =~ m|[^/]+$|;
  21.  
  22. ## ----------------------------------------------------------------------
  23. my $name = $&;
  24.  
  25. ## ----------------------------------------------------------------------
  26. use vars qw( $package );
  27. use vars qw( $quiet );
  28.  
  29. ## ----------------------------------------------------------------------
  30. Getopt::Long::Configure( 'no_ignore_case' );
  31. if ( ! GetOptions(
  32.           'quiet' => \$quiet,
  33.           'remove=s' => \$package,
  34.           )
  35.      )
  36. {
  37.     &usage();
  38.     exit 1;
  39. }
  40.  
  41. ## ----------------------------------------------------------------------
  42. if ( ! defined( $package ) )
  43. {
  44.     &usage();
  45.     exit -1;
  46. }
  47.  
  48. ## ----------------------------------------------------------------------
  49. &remove( $package );
  50.  
  51. ## ----------------------------------------------------------------------
  52. exit 0;
  53.  
  54. ## ----------------------------------------------------------------------
  55. sub remove
  56. {
  57.  
  58.     ## ------------------------------------------------------------------
  59.     my $package = $_[0];
  60.  
  61.     ## ----------------------------------------------------------------------
  62.     my $catalog = '/etc/sgml/transitional.cat';
  63.     my $backup  = '/etc/sgml/transitional.cat.old';
  64.  
  65.     ## ------------------------------------------------------------------
  66.     return if ( ! -f $catalog );
  67.  
  68.     ## ----------------------------------------------------------------------
  69.     my $top_marker    = '-- START SGML CATALOG ENTRY FOR PACKAGE';
  70.     my $bottom_marker = '-- END SGML CATALOG ENTRY FOR PACKAGE';
  71.     my $eol_marker    = '--';
  72.  
  73.     ## ------------------------------------------------------------------
  74.     my @data;
  75.  
  76.    ## -------------------------------------------------------------------
  77.     open( CATALOG, '<', $catalog )
  78.     or &error( "cannot open SGML catalog $catalog for reading: $!" );
  79.  
  80.    ## -------------------------------------------------------------------
  81.     while ( <CATALOG> )
  82.     {
  83.     chop;
  84.     if ( /$top_marker $package $eol_marker/o )
  85.     {
  86.         if ( $data[ $#data ] =~ /^\s*/o )
  87.         {
  88.         pop( @data );
  89.         }
  90.         while ( !/$bottom_marker $package $eol_marker/o )
  91.         {
  92.         if ( not ($_ = <CATALOG>) )
  93.         {
  94.             &error( "cannot find bottom marker for package $package:\n    $bottom_marker $package $eol_marker\nplease remove the entry for $package manually" );
  95.         }
  96.         }
  97.     }
  98.     else
  99.     {
  100.         push( @data, $_ );
  101.     }
  102.     }
  103.  
  104.     ## ------------------------------------------------------------------
  105.     close( CATALOG )
  106.     or &error( "cannot close SGML catalog $catalog: $!" );
  107.  
  108.     ## ------------------------------------------------------------------
  109.     if ( -f $catalog )
  110.     {
  111.     if ( -f $backup )
  112.     {
  113.         unlink( $backup )
  114.         or &error( "cannot remove backup of catalog $backup: $!" );
  115.     }
  116.     rename( $catalog, $backup )
  117.         or &error( "cannot rename $catalog to $backup: $!" );
  118.     }
  119.  
  120.     ## ------------------------------------------------------------------
  121.     open( CATALOG, '>', $catalog )
  122.     or &error( "cannot open SGML catalog $catalog for writing: $!" );
  123.  
  124.     ## ------------------------------------------------------------------
  125.     for ( @data )
  126.     {
  127.     print CATALOG "$_\n";
  128.     }
  129.  
  130.     ## ------------------------------------------------------------------
  131.     close( CATALOG )
  132.     or &error( "cannot close SGML catalog $catalog: $!" );
  133.  
  134. } ## remove
  135.  
  136. ## ----------------------------------------------------------------------
  137. sub usage
  138. {
  139.  
  140.     ## ------------------------------------------------------------------
  141.     print STDERR <<END;
  142. Usage:
  143.     $name --remove package
  144. END
  145.  
  146. } ## usage
  147.  
  148. ## ----------------------------------------------------------------------
  149. sub error
  150. {
  151.  
  152.     ## ------------------------------------------------------------------
  153.     die "$name: error: $_[0]\n";
  154.  
  155. } ## error
  156.  
  157. ## ----------------------------------------------------------------------
  158.